home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / vscrollBar < prev   
Encoding:
Text File  |  1994-11-06  |  3.8 KB  |  173 lines  |  [TEXT/MSET]
  1. (*
  2.  
  3. A selection object.  The scrollbars are fully functional and will respond to
  4. mouse clicks without additional setup.  Scrolling is accomplished by
  5. sending late bound messages to a second object, the object to be scrolled,
  6. which we call the OwnerObject.
  7.  
  8. The default object to be scrolled is nullOwnerObject which accepts the
  9. required messages from the scrollbar ( prescroll:, postscroll:, and draw:).
  10. We can have the scrollbar control any other object by using the 
  11. scrolledby: method.  Of course we must define methods that behave
  12. properly to the scrollbar messages.
  13.  
  14. See the use of scrollbars in classes tescroll, editlist, and pictscroll.
  15.  
  16. Note that the number of pixels to scroll and the max and min
  17. control values must be set up as well.  Default values
  18. are provided that are reasonable.  Perhaps we should have a method
  19. that inspects the object to be scrolled for those values?  Also, the
  20. rectangle to scroll must be set up via setscrollrect:.
  21.  
  22. *)
  23.  
  24.  
  25. :class OwnerObj super{ object }
  26.  
  27. :m prescroll: ;m
  28. :m postscroll: ;m
  29. :m draw: ;m
  30.  
  31.  ;class
  32.  
  33. OwnerObj nullOwnerObject
  34.  
  35.  
  36. :class    vscrollBar  super{ baseControl }
  37.     int controlWas
  38.     dicaddr scrollObject
  39.     int pixDelta    \ number of pixels to scroll corresponding to up/dn arrow
  40.     int pageN    \ pixDelta multiplier corresponding to page up/dn
  41.     rect+ scrollRect
  42.     int lo
  43.     int hi
  44.     handle theregion
  45.  
  46. :m setScrollRect: ( l t r b -- )
  47.     put: scrollRect ;m
  48.  
  49. :m setScrollValues: ( pixdelta pageN -- )
  50.     put: pageN  put: pixDelta ;m
  51.  
  52. :m >RECT:  { x y len -- left top rt bot }
  53.     x  y   x 16 +    y len + ;m
  54.  
  55. :m init: ( x y len -- )
  56.     >RECT: self put: bounds ;m
  57.  
  58. :m scrolledBy:  ( obj -- )
  59.     put: scrollObject ;m
  60.  
  61. :m set: ( n -- )
  62.     dup put: super
  63.     put: controlWas ;m
  64.  
  65. :m new:  { wptr -- }  \ must be compatible with selection objects
  66.     wptr put: wind
  67.     
  68.     0            \ room for ControlHandle
  69.     wptr        \ theWindow
  70.     addr: bounds \ boundsRect
  71.     nullOSstr    \ title
  72.     true tbool    \ visible
  73.     get: super makeint    \ value
  74.     int: lo  int: hi    \ min,max
  75.     int: procid
  76.     self         \ refcon
  77.     call NewControl  put: ctlHndl
  78.     ;m    
  79.  
  80. :m deactivate:    \ Sets the control to 255 hiliting (disabled)
  81.     255 hilite: super  ;m 
  82.  
  83. :m PUTRANGE:  { l h -- }
  84.     alive?: self
  85.     IF
  86.         get: ctlHndl  l makeInt  call SetMinCtl
  87.         get: ctlHndl  h makeInt  call SetMaxCtl
  88.     THEN
  89.     l put: lo
  90.     h put: hi ;m 
  91.  
  92. :m getrange: ( -- lo hi )
  93.     get: lo  get: hi    \ we always maintain these
  94.     ;m
  95.  
  96. :m classinit:
  97.     20 ( x ) 20 ( y ) 100 ( len ) init: self
  98.     konst scrollBarProc  put: procID
  99.      1 10 setScrollValues: self
  100.      0 0 0 0 setScrollRect: self
  101.      0 100 putrange: self
  102.     nullOwnerObject put: scrollObject  \ 06Mar94 DBH,  ok because using dicaddr
  103.     ;m
  104.  
  105. :m windRegion:  ( -- rgn )
  106.     get: wind 122 + @ ;m
  107.  
  108. :m dh: ( -- dh )
  109.     0 ;m
  110.  
  111. :m dv: ( -- dv )
  112.     get: controlWas  get: self -  get: pixDelta * ;m
  113.  
  114. :m ScrollOnce:
  115.     addr: scrollRect
  116.     dh: [self]
  117.     dv: [self]
  118.     pack
  119.     windRegion: self
  120.     call ScrollRect
  121.     get: self  put: controlWas
  122.     windRegion: self call ValidRgn
  123.     draw: [ get: scrollObject ]   \ force a draw
  124.     ;m
  125.  
  126. \ we late bind in DoCtl: and DoThumb: to allow for a different ScollOnce:
  127. \ in text edit scrolls and hscrolls
  128.  
  129. :m DoCtl:  ( n -- )
  130.     get: self +  put: self
  131.     ScrollOnce: [self] ;m
  132.  
  133. :m DoThumb:
  134.     ScrollOnce: [self] ;m
  135.  
  136. :m prescroll:
  137.     prescroll: [ get: scrollObject ] ;m
  138.  
  139. :m postscroll:
  140.     postscroll: [ get: scrollObject ] ;m
  141.  
  142. CallFirst prescroll:
  143. CallLast postscroll:
  144.  
  145.  
  146. \ exec: will be called via click: in superclass
  147.  
  148. :m exec:  ( part# -- )
  149.     CASE
  150.     konst inThumb        OF    DoThumb: self                    ENDOF
  151.     konst inUpButton    OF    -1 DoCtl: self                    ENDOF
  152.     konst inDownButton    OF    1 DoCtl: self                      ENDOF
  153.     konst inPageUp        OF    get: pageN negate  DoCtl: self    ENDOF
  154.     konst inPageDown    OF    get: pageN DoCtl: self            ENDOF
  155.     ENDCASE
  156.     ;m
  157.  
  158. :m release:
  159.     release: super
  160.     nullOwnerObject put: scrollObject ;m \ 29Jul94 DBH  so we don't crash upon next new:
  161.  
  162. ;class
  163.  
  164. endload
  165.  
  166. *** EXAMPLE USE
  167.  
  168. selwindow w
  169. test: w 
  170.  
  171. vscrollbar v
  172. v add: w
  173.